home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
WZSEND.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-06-26
|
17KB
|
506 lines
UNIT WZSend;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ SendWaZOO Processor Last changed: 26.06.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-96 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ Birger Kristensen ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos;
FUNCTION SendReqFiles(SendMode: Byte; Net, Node: Integer): Boolean;
FUNCTION SendWaZOO(SendMode: Byte): Boolean;
IMPLEMENTATION
USES OpCrt, OpDate, OpDos, OpString, ApTimer,
Event, Com, MailUtil, Globals, ZMisc, ZSend, NodeList, BiMail,Util,
FileUtil, StrUtil, Protocol, Modem, ParseReq, PTpl, LogFile, PoPTypes;
VAR
tempsr : SEARCHREC;
FUNCTION SendMDM7(FName: S30): Boolean;
LABEL
Top, Fubar;
VAR
OrigFName,
Stat : S30;
i,XChkSum,
Tries : Byte;
Timer : EventTimer;
InByte : Integer;
ch:BYTE;
BEGIN
SendMDM7:=False;
OrigFName:=FName;
ComPort^.SetXOn(Off);
FName:=StUpCase(Pad(JustName(FName),8)+Pad(JustExtension(FName),3))+#0;
Tries:=0;
XChkSum:=SUB;
FOR i:=1 TO 11 DO
Inc(XChkSum, Byte(FName[i]));
NewTimerSecs(Timer, 60);
Top:
i:=1;
Inc(Tries);
Stat:='Que WHAT??';
WHILE ComPort^.Carrier AND (Tries<8) AND NOT (TimerExpired(Timer)) DO
BEGIN
InByte:=TimedRead(6000); { 100 }
CASE InByte OF
NAK : BEGIN
ComPort^.WriteByte(Ack, False);
ComPort^.WriteByte(Byte(FName[1]), True);
Inc(i);
IF ComPort^.KeyPressed THEN
BEGIN
ComPort^.Peek(ch);
IF ch=NAK THEN ch:=ComPort^.ReadByte;
END;
END;
ACK : IF i=12 THEN
BEGIN
ComPort^.WriteByte(SUB, True); { Rettet false til True 20/4-95}
InByte:=TimedRead(100);
IF InByte=XChkSum THEN
BEGIN
ComPort^.WriteByte(ACK, True);
{ AddLog('!', 'Modem 7 filename færdig'); }
SendMDM7:=True;
Exit;
END ELSE
BEGIN
AddLog('!', 'Checksum error on Modem 7 filename');
ComPort^.WriteByte(Byte('u'), True);
GOTO Top;
END;
END ELSE
BEGIN
ComPort^.WriteByte(Byte(FName[i]), True);
Inc(i);
END;
{
Byte('C') : BEGIN
AddLog('!','File: '+OrigFName+' skipped by remote');
Exit;
END;
}
ELSE BEGIN
ComPort^.WriteByte(Byte('u'), True);
GOTO Top;
END;
END;
END;
Fubar:
IF Tries>=7 THEN Stat:='FUBAR....';
AddLog('!', Stat);
END;
FUNCTION SendReqFiles(SendMode: Byte; Net, Node: Integer): Boolean;
VAR
FreeArea : TFreeArea;
s : String;
TransTime : Time;
GotIt : Boolean;
BEGIN
IF (ComPort^.GetBaudRate>=Cfg.Request.MinBaud) AND InitReqFile(Net,Node) THEN
BEGIN
SendReqFiles:=True;
tempsr.attr:=0;
tempsr.size:=0;
addtpl(rspfile,'HEADER', tempsr);
IF (Cfg.Request.Limit[nsUnknown,rlPrCall].MaxFiles=0) AND (GlobNodeStat=nsUnknown) THEN
AddTpl(rspfile,'UNKNOWN', tempsr);
IF Cfg.Request.Limit[GlobNodeStat,rlPrCall].MaxFiles>0 THEN
BEGIN
REPEAT
s:=GetNextFileToSend(FreeArea);
IF s<>'' THEN
BEGIN
IF (MaxReqFiles>0) OR (FreeArea=faTotally) THEN
BEGIN
IF (MaxReqBytes-ReqSr.Size>=0) OR (FreeArea=faTotally) THEN
BEGIN
TransTime:=ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10);
IF (TimeToNoMoreRequest>TransTime) AND
((MaxReqTime>TransTime) OR (FreeArea=faTotally)) THEN
BEGIN
GotIt:=True;
CASE SendMode OF
0: AddToTransferList(s, False);
1: BEGIN
GotIt:=ZModemSend(s, '', fsent, 8192)=ZTrue;
Inc(FSent);
END;
2: ;
END;
Dec(TimeToNoMoreRequest, TransTime);
IF (FreeArea=faNoWay) AND GotIt THEN
BEGIN
Dec(MaxReqFiles); Dec(MaxReqBytes,ReqSr.Size);
Dec(MaxReqTime,TransTime);
WITH DRI DO
BEGIN
Inc(NumFiles); Inc(NumBytes, ReqSr.Size);
Inc(UsedTime, TransTime);
END;
END;
Inc(tempsr.attr);
Inc(tempsr.size, reqsr.size);
AddTpl(rspfile,'FOUND', reqsr);
END ELSE
BEGIN
AddTpl(rspfile, 'TIMEOUT', reqsr);
AddLog('#','Not enough time (Lft: '+
TimeToTimeString('Hh:mm:ss',Min(MaxReqTime,TimeToNoMoreRequest))+
'/Tfr: '+
TimeToTimeString('Hh:mm:ss',TransTime)+'): '+s);
END;
END ELSE
BEGIN
AddTpl(RspFile,'TOOBIG',ReqSr);
AddLog('#','File too big ('+Long2Str(MaxReqBytes)+'): '+s);
END;
END ELSE
BEGIN
AddTpl(RspFile,'TOOMANY',reqsr);
AddLog('#','Too many files '+s);
END ;
END;
UNTIL s='';
END;
END ELSE
SendReqFiles:=False;
END;
PROCEDURE RespondToFileRequest(SendMode: Byte);
VAR
MustDoFoot : Boolean;
SendName : String;
Net, Node, i : Integer;
BEGIN
StartTime:=CurrentTime;
IF (CurrentEvent.Typ AND etRequests<>0) AND NOT NodesRec.DisallowReq AND ReqOk THEN
BEGIN
MustDoFoot:=False;
FOR i:=1 TO MaxAddresses DO
BEGIN
Net:=Cfg.Addresses[i].Net;
Node:=Cfg.Addresses[i].Node;
IF SendReqFiles(SendMode,Net,Node) THEN MustDoFoot:=True;
END;
IF MustDoFoot THEN
BEGIN
WriteSuckerInfo(DRI);
AddTpl(RspFile, 'FOOT', TempSr);
END;
IF ExistFile(RspFile) THEN
BEGIN
IF Cfg.Request.RspAsPkt THEN SendName:=InventPktName ELSE SendName:='';
CASE SendMode OF
0: AddToTransferList(rspfile, Cfg.Request.RspAsPkt);
1: BEGIN
ZModemSend(rspfile, SendName, fsent, 8192);
Inc(FSent);
DeleteFile(RspFile);
END;
2: ;
END;
END;
END;
END;
FUNCTION DoFLOfile(CONST ExtFlags: S5; SendMode: Byte): Boolean;
LABEL
next;
VAR
SkippedOne : Boolean;
Res,
Io, ZRes : Integer;
FName,
HoldName : PathStr;
c, Tries : Byte;
fp : FILE;
s, SPtr : STRING;
Current,
LastStart : LongInt;
i, ch : Char;
Srec : SearchRec;
BEGIN
DoFLOfile:=False;
HoldName:=HoldAreaPath(Call,False);
IF ChkDir(HoldName) THEN
BEGIN
FOR c:=1 TO 5 DO
BEGIN
SkippedOne:=False;
FName:=HoldFileName(Call,False)+ExtFlags[c]+'LO';
Assign(fp, FName); FileMode:=ShareRW+ShareDenyW;
Tries:=0;
REPEAT
Reset(fp,1);
Io:=IOResult;
IF Io=5 THEN
BEGIN
Pause(50);
Inc(Tries);
END;
UNTIL (Io<>5) Or (Tries=10);
IF Io=0 THEN
BEGIN
Current:=0;
WHILE NOT EoF(fp) DO
BEGIN
LastStart:=Current;
ReadLine(fp,s);
SPtr:=s;
Current:=FilePos(fp);
IF SPtr[1]=TruncAfter THEN
BEGIN
SPtr:=Copy(SPtr, 2, Length(SPtr) - 1);
i:=TruncAfter;
END ELSE
IF SPtr[1]=ShowDeleteAfter THEN
BEGIN
SPtr:=Copy(SPtr, 2, Length(SPtr) - 1);
i:=ShowDeleteAfter;
END ELSE
i:=NothingAfter;
IF Length(SPtr)=0 THEN GOTO next;
IF SPtr[1] <> '~' THEN
BEGIN
IF NOT isCaller AND ((CurrentEvent.Typ AND etNoFiles)<>0) AND
(StUpCase(Copy(SPtr, 1, Length(Cfg.Outbound)))<>StUpCase(Cfg.Outbound)) THEN
BEGIN
SkippedOne:=True;
GOTO Next;
END;
FindFirst(SPtr, AnyFile, Srec);
IF DOSError <> 0 THEN
BEGIN
AddLog('!', 'File not found ' + SPtr);
FindClose(SRec);
GOTO Next;
END;
FindClose(SRec);
IF Srec.size=0 THEN GOTO Next;
CASE SendMode OF
0: AddToTransferList(SPtr,FALSE);
1: BEGIN
ZRes:=ZModemSend(SPtr, '', fsent, 8192);
IF (ZRes<>ZTRUE) And (ZRes<>SPEC_COND) THEN
BEGIN
Close(fp);
NetProblems:=1;
Exit;
END;
END;
2: BEGIN
IF SendMDM7(JustFileName(Sptr)) THEN
BEGIN
Res:=SendFile(SPtr,'',TeLink);
IF Res<>1 THEN
BEGIN
Close(fp);
AddLog('!', 'Error sending: '+SPtr);
Exit;
END;
END ELSE
SkippedOne:=True;
END;
END;
Inc(fsent);
IF SendMode<>0 THEN
BEGIN
IF ((SendMode=1) AND (ZRes<>SPEC_COND)) OR
(SendMode=2) THEN
BEGIN
Seek(fp, LastStart);
Ch:=#126;
BlockWrite(fp, Ch, 1);
Seek(fp, Current);
IF i=TruncAfter THEN
BEGIN
TruncateFile(SPtr);
AddLog('#', 'Flagging ' + SPtr + ' as sent');
END ELSE
IF i=ShowDeleteAfter THEN
BEGIN
IF DeleteFile(SPtr) THEN AddLog('#', 'Unlinking ' + SPtr);
END ELSE
IF i=DeleteAfter THEN DeleteFile(SPtr);
END;
IF (SendMode=1) AND (ZRes=SPEC_COND) THEN SkippedOne:=True;
END;
END;
Next:
END; { While }
Close(fp);
IF (SendMode<>0) AND NOT SkippedOne THEN DeleteFile(FName);
END ELSE { Not found }
IF Io=5 THEN AddLog('!','Mail locked by other task');
END; { For }
END;
DoFLOfile:=True;
END;
FUNCTION SendWaZOO(SendMode: Byte): Boolean;
VAR
SentReqName:S12;
c,AkaNum : Byte;
FName, HoldName : PathStr;
NoMoreAkas,OutFileSent:Boolean;
LocFSent : Word;
GemAdr : TFidoAddress;
BusyFile : File;
FUNCTION SendOutFile: Boolean;
VAR
i:WORD;
ph : TPktHeader;
f : File;
s,ss : String;
BEGIN
FillOutPktHeader(cfg.Addresses[Cfg.MainAdrNum],Call,ph);
FILLCHAR(ph.PassWord,SizeOf(Ph.PassWord),0);
Str2AsciiZ(NodesRec.SessionPwd,ph.PassWord,7);
s:=HoldFileName(Call,True)+'OUT';
Assign(f,s);
ReWrite(f,1);
BlockWrite(f,ph,SizeOf(ph));
i:=0;
BlockWrite(f,i,2);
CLOSE(f);
ss:=InventPktName;
i := SendFile(s, ss, TeLink);
DeleteFile(s);
SendOutFile:=(i<2);
END;
BEGIN
SendWaZOO:=False;
fsent:=0; LocFSent:=0;
OutFileSent:=FALSE;
GemAdr:=Call;
AkaNum:=0; NoMoreAkas:=False;
REPEAT
IF IsCaller THEN ExtFlags[1]:=' ' ELSE ExtFlags[1]:='H';
ExtFlags[3]:='O';
IF MarkNodeBusy(BusyFile,Call) THEN
BEGIN
HoldName:=HoldAreaPath(Call,False);
IF ChkDir(HoldName) THEN
BEGIN
FOR c:=1 TO 5 DO
BEGIN
FName:=HoldFileName(Call,False)+ExtFlags[c]+'UT';
IF ExistFile(FName) THEN
BEGIN
OutFileSent:=TRUE;
CASE SendMode OF
0: AddToTransferList(FName,TRUE);
1: IF ZModemSend(FName, InventPktName, fsent, 8192) <> ZTRUE THEN
BEGIN
NetProblems:=1;
UnMarkNodeBusy(BusyFile);
Exit;
END;
2: IF SendFile(FName, InventPktName, TeLink)<>1 THEN {rettet 0 til 1 BK}
BEGIN
NetProblems:=1;
UnMarkNodeBusy(BusyFile);
Exit;
END;
END;
Inc(fsent);
IF SendMode<>0 THEN
IF NOT DeleteFile(FName) THEN WriteLn('Error deleting ', FName);
END;
END;
IF (SendMode=2) AND NOT OutFileSent AND NOT SendOutFile THEN
BEGIN
UnMarkNodeBusy(BusyFile);
AddLog('!', 'Error sending dummy pkt file');
Exit;
END;
ExtFlags[3]:='F';
IF NOT DoFLOfile(ExtFlags, SendMode) THEN
BEGIN
UnMarkNodeBusy(BusyFile);
Exit;
END;
END;
IF SendMode=1 THEN
BEGIN
RequestSent:=False;
FName:=HoldFileName(Call,False)+'REQ';
IF ExistFile(FName) THEN
BEGIN
IF WzFreq IN RemHello.Capabilities THEN
BEGIN
RequestSent:=True;
AddLog(':', 'Making file request');
IF Call.Point<>0 THEN SentReqName:=HexW(Call.Net)+HexW(Call.Node)+'.REQ' ELSE SentReqName:='';
IF ZModemSend(FName, SentReqName, fsent, 8192)=ZTRUE THEN
BEGIN
IF NOT DeleteFile(FName) THEN AddLog('!','Error deleting '+FName);
END;
Inc(fsent);
END ELSE
AddLog(':','File request declined');
END;
{ Respond to file request }
END;
UnMarkNodeBusy(BusyFile);
END ELSE
AddLog(':',Address2Str(Call)+' is marked busy - skipping');
Inc(AkaNum);
IF (AkaNum<=MaxAddresses) And (RemAka[AkaNum].Zone<>0) THEN
BEGIN
Inc(LocFSent, FSent); FSent:=0;
Call:=RemAka[AkaNum];
AddLog(':','Sending to AKA: '+Address2Str(Call));
END ELSE
BEGIN
NoMoreAkas:=True;
IF AkaNum>1 THEN
BEGIN
FSent:=LocFSent+FSent;
END;
END;
UNTIL NoMoreAkas;
Call:=GemAdr;
IF SendMode<>2 THEN RespondToFileRequest(SendMode);
IF SendMode<>0 THEN
BEGIN
IF fsent=0 THEN
BEGIN
IF AkaNum=1 THEN AddLog('!', 'Nothing to send to: '+Address2Str(Call));
CASE SendMode OF
1: IF ZModemSend('', '', -2, 8192) <> ZTRUE THEN
BEGIN
NetProblems:=1;
Exit;
END;
2: IF SendMDM7('') THEN
IF SendFile('','',TeLink)<>0 THEN
BEGIN
NetProblems:=1;
Exit;
END;
END;
END ELSE
IF SendMode=1 THEN ZModemSend('', '',-1, 8192);
END;
SendWaZOO:=True;
END;
END.